Scene 96/Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso/misc/coding/onenssrc/part3.pas

Pascal/Delphi Source File | 1996-01-17 | 5.6 KB | 325 lines

unit Part3;

interface

uses
    zipvga, liktwk, crt, oneres, fastsine;

    procedure Run;

implementation

const
    firstframe = 2048;
    lastframe1 = firstframe + 1024;
    lastframe2 = lastframe1 + 1024 - 512;

var
    i, j, k, d : word;
    swerve : integer;
    aswerve : word;
    f : longint;
    scr, tab, pic : ^screen2;
    scrs, tabs, pics : word;

    procedure MakePic;

    var
        i, j : word;

    begin
        for i := 0 to 65535 do
            vscr2[i] := random(128) + random(128) + 1;
        pic^ := vscr2;
        {for i := 0 to 65535 do
            vscr2[i] := (pic^[i+1] + pic^[i-1] + pic^[i+256] + pic^[i-256]) div 8
                    + (pic^[i+321] + pic^[i - 321] + pic^[i+319] - pic^[i-319]) div 8;}
        for j := 0 to 2 do
         begin
            for i := 0 to 65535 do
                vscr2[i] := (pic^[i+1] + pic^[i] + pic^[i+320] + pic^[i+321]) div 4 + random(4) - random(4);
            pic^ := vscr2;
         end;
    end;

    procedure MakeTabs;

    var
        dx, dy : integer;
        z, d : longint;

    begin
        init60hz256256256c;
        brightness (63,0);
        {if not loadpic2('thing.tab', tab^) then}
         begin
            for dx := -128 to 127 do
             begin
                for dy := -64 to 63 do
                 begin
                    if dx = 0 then
                     begin
                        if dy > 0 then
                            tab^[(dy + 64)*256 + dx + 128] := 64
                        else
                            tab^[(dy + 64)*256 + dx + 128] := 192;
                     end
                    else
                        tab^[(dy + 64)*256 + dx + 128] := round(arctan(dy/dx)*256/2/pi);
                    if dx < 0 then
                        tab^[(dy + 64)*256 + dx + 128] := tab^[(dy + 64)*256 + dx + 128];
                 end;
                vscr2 := tab^;
             end;

            for dx := -128 to 127 do
             begin
                for dy := -64 to 63 do
                 begin
                    tab^[(dy + 64)*256 + 128*256 + dx + 128] := (tab^[(dy + 64)*256 + dx + 128] + 128) and 255;
                 end;
                vscr2 := tab^;
             end;

            savepic2 ('thing.tab', tab^);
         end;

        vscr2 := tab^;
        initvga;
    end;

procedure Run;

begin
    {new (scr);}
    scr := @vscr2;
    new (tab);
    new (pic);
    scrs := seg(scr^);
    tabs := seg(tab^);
    pics := seg(pic^);

    initb;
    initi;
    initvga;

    brightness (0, 0);

    {MakePic;}
    {readkey;}

    {MakeTabs;
    readkey;}
    fetch ('tunnel.tab');
    blockread (lf, tab^, 65535);

    fetch ('voxel.mp');
    blockread (lf, pic^, 65535);

    filldword (vscr, 16384, 0);

    j := 0;
    k := 0;
    f := 0;
    swerve := 0;
    repeat
        getpos;
        f := track*256 + row*4;
        if f < firstframe + 256 then
            brightness ((f - firstframe) div 4, 0)
        else if f > lastframe1 - 64 then
            brightness ((lastframe1 - f), 0);
        {for i := 0 to 32767 do
         begin
            d := tab^[i+32768];
            vscr2[i+63*256] := pic^[d*256 + tab^[i] + j*3*256 + j]*(255 - d) div 256;
         end;}

        {retrace;}
        {setrgb (0, 31, 0, 0);}

        if f >= firstframe + 64 then
            inc (swerve);
        {swerve := ssin(f);}
        aswerve := abs(swerve);

        {repeat until sync;
        sync := false;}
        if trapretrace then
            retrace;
        asm
            mov ax, k
            mov ah, al
            xor al, al
            mov si, ax
            add si, j

            mov cx, [aswerve]

            xor di, di
            cmp [swerve], 0
            jg @AtEnd
            xor al, al
            mov dx, [scrs]
            mov es, dx
            add di, 50*320
            rep stosb
            sub di, 50*320
         @AtEnd:

            mov cx, 32000
            sub cx, [aswerve]
         @Loop:
            mov dx, [tabs]
            mov es, dx

            add di, [swerve]
            mov bh, es:[di]
            sub di, [swerve]
            mov bl, es:[di+32768]

            mov dx, [pics]
            mov es, dx

            mov al, es:[bx+si]
            mov ah, 255
            sub ah, bl
            mul ah

            mov dx, 0A000h {[scrs]}
            mov es, dx

            mov es:[di+50*320], ah

            inc di
            dec cx
            jnz @Loop

            cmp [swerve], 0
            jl @AtBeginning
            add di, 50*320
            mov cx, [aswerve]
            xor al, al
            rep stosb
         @AtBeginning:
        end;
        {setrgb (0, 0, 0, 0);}

        {for i := 0 to 15 do
            inc (pic^[j + k*256], random(64));}

        inc (j, 2);
        inc (k, 1);
    until keypressed or (f >= lastframe1);

    if keypressed then
        readkey;

    init60hz256256256c;

    fetch ('thing.tab');
    blockread (lf, tab^, 65535);

    fetch ('voxel.mt');
    blockread (lf, pic^, 65535);

    filldword (vscr, 16384, 0);

    j := 0;
    k := 0;
    f := 0;
    repeat
        getpos;
        f := track*256 + row*4;
        if f < lastframe1 + 256 then
            brightness ((f - lastframe1) div 4, 0)
        else if f > lastframe2 - 64 then
            brightness ((lastframe2 - f), 0);
        {for i := 0 to 32767 do
         begin
            d := tab^[i+32768];
            vscr2[i+63*256] := pic^[d*256 + tab^[i] + j*3*256 + j]*(255 - d) div 256;
         end;}

        {retrace;}
        {setrgb (0, 31, 0, 0);}

        {swerve := swerve + ssin(f) div 16;}
        swerve := (ssin(f*4) div 16 + scos(f*3 + 10) div 8)*256 + (ssin(f*5 + 15) div 8 + scos(f*6 + 20) div 16);
        aswerve := abs(swerve);

        {repeat until sync;
        sync := false;}

        if trapretrace then
            retrace;
        asm
            mov ax, k
            mov ah, al
            xor al, al
            mov si, ax
            add si, j

            mov cx, [aswerve]

            xor di, di
            {cmp [swerve], 0
            jg @AtEnd}
            xor al, al
            mov dx, [scrs]
            mov es, dx
            add di, 63*256
            rep stosb
            sub di, 63*256
         @AtEnd:

            mov cx, 32768
            sub cx, [aswerve]
         @Loop:
            mov dx, [tabs]
            mov es, dx

            mov bh, es:[di]
            add di, [swerve]
            mov bl, es:[di+32768]
            sub di, [swerve]

            mov dx, [pics]
            mov es, dx

            mov al, es:[bx+si]
            {mov ah, 255
            sub ah, bl
            mul ah}

            mov dx, 0A000h {[scrs]}
            mov es, dx

            mov es:[di+63*256], al

            inc di
            dec cx
            jnz @Loop

            cmp [swerve], 0
            jl @AtBeginning
            add di, 63*256
            mov cx, [aswerve]
            xor al, al
            rep stosb
         @AtBeginning:
        end;
        {setrgb (0, 0, 0, 0);}

        {for i := 0 to 15 do
            inc (pic^[j + k*256], random(64));}

        inc (j, 2);
        inc (k, 1);
    until keypressed or (f >= lastframe2);

    dispose (tab);
    dispose (pic);
end;

end.